home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / BlitzList / BlitzListFiles / FastTest / FastRamTest.ascii
Encoding:
Text File  |  1998-04-24  |  6.0 KB  |  193 lines
  1. ;Palette Remapping example
  2. ;Fast Ram bitmap testing code added APR 24, 1998
  3. ;by Curt Esser   camge@ix.netcom.com
  4. ;speed improvements thanks to Xavier Nuel ( BadDolls )
  5. ;use any part of this in any way you like
  6.  
  7. ;NOTE : NEEDS  BDGFX library! (C) BadDolls Production
  8. ;You can find this small library in Aminet/dev/basic
  9. ;or at http://www.a2points.com/homepage/3698138
  10.  
  11. ;NOTE : The remapping part of the code only works on AGA systems!
  12.  
  13. WBStartup                       ;just in case!
  14. WBenchToFront_                  ;make sure it shows
  15. WbToScreen 0                    ;grab the wb screen
  16. ScreensBitMap 0,0
  17. NoCli                           ;don't need that!
  18.  
  19.  
  20. ;==== Get info about current Workbench Screen and grab it's palette =======
  21.  
  22. Dim col.w(255)                  ;for storing colour matches
  23. maxw=WBWidth                    ;these are used to set our window
  24. maxh=WBHeight                   ;size later
  25. wd.w=WBDepth                    ;number of bitplanes of WB
  26. WBcolors.w=2^wd                 ;convert this to number of colours
  27. aga.b=CheckAGA                  ;see if system is AGA
  28. MaxLen fi$=200                  ;these are needed for the
  29. MaxLen pa$=200                  ;ASL requestor
  30. accuracy.w=0                    ;accuracy of remapping - 0-255
  31.                                 ;higher = faster but less accurate
  32.  
  33. ;------------- Store the WB palette as palette #0 -------------------------
  34.  
  35. InitPalette 0,WBcolors          ;set up palette 0 to WB depth
  36.  
  37. For i=0 To WBcolors-1
  38.   AGAPalRGB 0,i,AGARed(i),AGAGreen(i),AGABlue(i)
  39. Next
  40.  
  41. ;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  42.  
  43. Repeat                          ;TEST LOOP STARTS HERE!
  44.  
  45.   Window 0,0,0,1,1,$1000,"",1,0 ;needed for requestors
  46.   CatchDosErrs                  ;show requestors here!
  47.  
  48.   picpath$=ASLFileRequest$("Select IFF picture",pa$,fi$)
  49.   If picpath$="" Then End       ;exit program when "cancel" is selected
  50.  
  51.   error$=""
  52.   If ReadFile(0,picpath$)       ;make sure it is a valid iff picture file!
  53.     FileInput 0
  54.     header$ = Inkey$(2000)      ;Read 2000 bytes of the header
  55.     CloseFile 0
  56.     WindowInput 0
  57.  
  58.     ;IFF picture header should read: FORM....ILBM
  59.  
  60.     If Left$(header$,4)<> "FORM" OR Mid$(header$,9,4) <> "ILBM"
  61.       If Left$(header$,3)="GIF" Then error$="GIF "
  62.       If Mid$(header$,7,4)="JFIF" Then error$="JPEG"
  63.       If Mid$(header$,9,4)="ANIM" Then error$="ANIM"
  64.       If error$="" Then error$="ERROR"
  65.  
  66.     Else                        ;Valid IFF header found!
  67.       ham=False                 ;we can't remap HAM pic, so check
  68.       x.w=Instr(header$,"CAMG")
  69.       If x<>0
  70.         a$=Left$(Right$(Hex$(Peek.l(&header$+x+7) AND $88A4),3),1)
  71.         If a$="8" Then error$="HAM "
  72.       EndIf
  73.       x=Instr(header$,"CMAP")   ;24 bit pics will crash!
  74.       If x=0 Then error$="True Color (24 bit)"
  75.     EndIf
  76.   Else                          ;couldn't even find the file!
  77.     error$="NF"
  78.   EndIf
  79.  
  80.   If error$=""                  ;Valid iff picture selected!
  81.  
  82. ; ------ check for enough chip memory for the conversion -----------------
  83.  
  84.     ILBMInfo picpath$           ;read the pictures size information
  85.  
  86.     sd.w=ILBMDepth
  87.     sh.w=ILBMHeight
  88.     sw.w=ILBMWidth
  89.     planemem.l=sh*sw/8          ;bytes needed for 1 bitplane of this pic
  90.     planes.b=wd                 ;calculate total bitplanes needed
  91.     planes+sd
  92.     chipstart.l=AvailMem_(#MEMF_CHIP)
  93.     mem.l=planes*planemem+20000 ;total chipmem required & some padding
  94.     memfast.l=AvailMem_(#MEMF_FAST|#MEMF_LARGEST)
  95.     If mem>memfast
  96.       error$="MEM"
  97.     EndIf
  98.   EndIf
  99.  
  100.   If error$=""                  ;get ready to process picture
  101.     b1size.l=sw*sh*wd/8         ;memory needed for "input" bitmap
  102.     b2size.l=sw*sh*sd/8         ;memory needed for "output" bitmap
  103.     b1.l=AllocMem_(b1size,#MEMF_FAST)
  104.     *b1p =b1
  105.     CludgeBitMap 1,sw,sh,wd,b1
  106.     b2.l=AllocMem_(b2size,#MEMF_FAST)
  107.     *b2p=b2
  108.     CludgeBitMap 2,sw,sh,sd,b2
  109.  
  110.     LoadBitMap 2,picpath$,1     ;now load the pic & it's palette
  111.     shapecolors.w=2^sd          ;convert depth to number of colours
  112.     chipused.l = chipstart-AvailMem_(#MEMF_CHIP)
  113.     rq$=Str$(sw)+"x"+Str$(sh)+"x"+Str$(shapecolors)+"|Picture loaded"
  114.     rq$=rq$+"|"+Str$(chipused)+" bytes of chip ram used"
  115.     Request "",rq$,"OK"
  116.     Format""
  117.     i$="Remap "+Str$(sw)+" x "+Str$(sh)+"  "
  118.     i$=i$+Str$(shapecolors)+" colour picture      "
  119.  
  120. ;-------------Remap the picture's palette to WB palette--------------------
  121.  
  122.     PaletteInfo 1
  123.         For i = 0 To shapecolors-1   ;remap the shape to wb screen
  124.           col(i)=FindColor(0,AGAPalRed(i),AGAPalGreen(i),AGAPalBlue(i),accuracy)
  125.         Next
  126.  
  127.       a=PICreateRequest(i$,0,sw,1)
  128.  
  129.  
  130.       For x=0 To sw-1
  131.         a=PIUpdateRequest(x)
  132.         For y=0 To sh-1
  133.           Use BitMap 2
  134.           match=Point(x,y)
  135.           Use BitMap 1
  136.           Plot x,y,col(match)
  137.         Next y
  138.       Next x
  139.  
  140.     ;Free BitMap 2
  141.     success=FreeMem_(*b2p,b2size)
  142.     VWait
  143.     PIEndRequest
  144.  
  145. ;------------Open a window and put the picture on it-----------------------
  146.  
  147.     winwid=sw
  148.     If winwid>maxw Then winwid=maxw
  149.     winhi=sh
  150.     If winhi>maxh Then winhi=maxh
  151.     winx=maxw/2-winwid/2
  152.     winy=maxh/2-winhi/2
  153.  
  154.     Free Window 0
  155.     Window 0,winx,winy,winwid,winhi,$800|$1000,"",1,0
  156.     BitMaptoWindow 1,0,0,0,0,0,winwid,winhi
  157.  
  158.     Free Palette 1
  159.  
  160.   Else                          ;We can't use the file - tell 'em why!
  161.       Rq$=""
  162.       If error$="MEM"
  163.         Format "#,##0,000"
  164.         Rq$="Not enough chip memory|Need:"+Str$(mem)+" bytes|Have:"+Str$(memchip)+" bytes"
  165.       EndIf
  166.       If error$="ERROR" Then Rq$="Unrecognized file type|"
  167.       If Rq$=""
  168.         Rq$="Can't process selected file|"
  169.         If error$="NF"
  170.           Rq$=Rq$+"File not found!"
  171.         Else
  172.           Rq$=Rq$+error$+" pictures not supported|"
  173.         EndIf
  174.       EndIf
  175.       If error$<>"NF" AND error$<>"MEM" Then Rq$=Rq$+"Pictures must be IFF - ILBM"
  176.       Request "Graphic load error",Rq$,"Cancel"
  177.   EndIf
  178.  
  179.  
  180.  
  181.  
  182. ;------------Wait until the close gadget is pressed------------------------
  183.   If error$=""                  ;if a picture was shown, wait for close gad
  184.     WaitEvent
  185.     Free Window 0
  186.     ;Free BitMap 1
  187.     success=FreeMem_(*b1p,b1size)
  188.   EndIf
  189. Forever
  190.  
  191.  
  192.  
  193.